perm filename SAVRES.SAI[SYS,HE] blob
sn#096065 filedate 1974-04-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SAVRES - save and restore procedures
C00005 00003 _ FILESP, EDSAVE
C00008 00004 _ EDREST
C00012 00005 _ LISAVE
C00014 00006 _ GET EDGE DATA
C00016 00007 _ LIREST
C00018 00008 _ PRSAVE
C00023 00009 _ PRREST
C00026 00010 _ GETLINES
C00028 00011 _ OUTLINES
C00030 ENDMK
C⊗;
COMMENT SAVRES - save and restore procedures
used at will, and automatically in the expansion/contraction schemes;
ENTRY FILESP,EDSAVE,EDREST,LISAVE,LIREST,PRSAVE,PRREST;
BEGIN "SAVRES"
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
DEFINE CL="'15&'12",
BL="'40",
_="COMMENT",
QRETURN="BEGIN UNTELL; RETURN END",
LOOP(I,J,K,L)="FOR I←J STEP L UNTIL K DO",
QEP="EXTERNAL SIMPLE PROCEDURE",
QEIP="EXTERNAL SIMPLE INTEGER PROCEDURE",
QESP="EXTERNAL SIMPLE STRING PROCEDURE",
QER="ERR←1",
QI="INTEGER",
QS="STRING",
SAFEX="SAFE";
STRING A, C, EDFILE, EDPPN, PRFILE, PRPPN, LIFILE, LIPPN;
INTEGER BRAK1, BRK2, IMAN, NEP, KICH, TVCAM;
INTERNAL STRING B, JUNKSTR;
INTERNAL INTEGER DCHAN, EO, IG;
EXTERNAL INTEGER IDUM,IA,IB,IC,IE,WHERE,BRCHAR,NOEPA,NOL,MAXNOL,
NOBAL,MAXNOV,NOUT,X,Y,ERR,MAXPLS,MAXPVS,NPRO,MXNPRO,PLTOT,
PLFTOT,PCFTOT,PFTOT,PFFREE,MAXPLT,PFREE,NOV,NOEPL;
EXTERNAL STRING NAME,EDEXT,LIEXT,PREXT;
EXTERNAL REAL RDEP;
SAFEX INTEGER ARRAY LIM[1:4];
SAFEX REAL ARRAY TFORM[1:15,1:3];
SAFEX EXTERNAL STRING ARRAY PNAME[1:1];
SAFEX EXTERNAL INTEGER ARRAY LE,LEDG1,LEDG2,LCREDE,LVERSI,LVERCO,LVER,
LINK,PLINES,PVERTS,PPTRL,PLINEF,PLINE,PLINE2,PFLST,PFPRO,PFEAT[1:1],
PFPTR[0:1],DICH[0:15];
SAFEX EXTERNAL REAL ARRAY EAX,EAY,EBX,EBY,XVCOR,YVCOR,SVANG,XLCOR,YLCOR,
CXL,CYL,CCL,RLEN,ANGARG[1:1];
QEP UNTELL;
QESP PL(QS S,T; QI I);
QEP TELL(QS S);
QESP QREAD;
QEP SORTED;
QEP SHUFFL;
QEIP LACT(QI I);
_ FILESP, EDSAVE;
_ Reads in file, ext, ppn for (I=1) line-, (I=2) edge-,
(I=3) prototype files;
INTERNAL SIMPLE PROCEDURE FILESP(INTEGER I);
BEGIN "FILESP"
JUNKSTR←QREAD;
A←SCAN(JUNKSTR,2,BRK2);
B←IF (IA←BRK2)='56 THEN IA&SCAN(JUNKSTR,2,BRK2) ELSE NULL;
C←IF BRK2='133 THEN BRK2&JUNKSTR ELSE NULL;
CASE I OF BEGIN ;
BEGIN LIFILE←A; LIEXT←B; LIPPN←C END;
BEGIN EDFILE←A; EDEXT←B; EDPPN←C END;
BEGIN PRFILE←A; PREXT←B; PRPPN←C END
END
END "FILESP";
_ Saves sorted edge-data;
INTERNAL SIMPLE PROCEDURE EDSAVE;
BEGIN "EDSAVE"
IF ¬NOEPA THEN RETURN;
TELL("edge-save");
OPEN(4,"DSK",'14,0,2,IDUM,BRCHAR,EO);
IF EQU(EDEXT,".TEM") THEN BEGIN EDFILE←"EDSAVE"; EDPPN←NULL END;
ENTER(4,EDFILE&EDEXT&EDPPN,IA);
WORDOUT(4,NOEPA);
WORDOUT(4,KICH);
ARRYOUT(4,TFORM[1,1],45);
WORDOUT(4,RDEP);
ARRYOUT(4,LE[1],NOEPA);
ARRYOUT(4,EAX[1],NOEPA);
ARRYOUT(4,EAY[1],NOEPA);
ARRYOUT(4,EBX[1],NOEPA);
ARRYOUT(4,EBY[1],NOEPA);
RELEASE(4);
UNTELL
END "EDSAVE";
_ Kludge to get around bug in REALIN;
SIMPLE REAL PROCEDURE REALIX(INTEGER C);
BEGIN STRING S;
INTEGER SIGN;
S ← INPUT(C,6);
IF LENGTH(S)∧S[1 FOR 1]="-" THEN
BEGIN SIGN ← -1; S←S[2 TO ∞]; END ELSE SIGN ← 1;
RETURN(SIGN*(CVD(S)+REALIN(C)));
END;
_ EDREST;
_ Inputs edge-files;
INTERNAL SIMPLE PROCEDURE EDREST;
BEGIN "EDREST"
LABEL BA1,EDP,EDPV,EDOUT,EDPV1,EDPV2;
REAL X,Y,DX,DY;
IF WHERE≠11 THEN TELL("edge-input") ELSE GO EDP;
IF EQU(EDEXT,".DAT") THEN IMAN←0 ELSE
IF EQU(EDEXT,".EDG") THEN IMAN←1 ELSE
IF EQU(EDEXT,".SED") THEN IMAN←2 ELSE
IF EQU(EDEXT,".TEM") THEN
BEGIN
IF ¬NOEPA THEN RETURN;
IMAN←3
END ELSE BEGIN
OUTSTR("WRONG EXT: "&EDEXT&CL);
QER;
QRETURN
END;
OPEN(4,"DSK",12*(IMAN%2),2,0,1000,BRAK1,EO);
LOOKUP(4,JUNKSTR←EDFILE&EDEXT&EDPPN,IA);
IF IA THEN
BEGIN
OUTSTR("FILE "&JUNKSTR&" NOT FOUND"&CL);
RELEASE(4);
QER;
QRETURN
END;
IF IMAN≤2 THEN NOL ← NOV ← 0;
CASE IMAN OF BEGIN
BEGIN
RDEP←REALIX(4);
NOEPA←(NEP←INTIN(4))%2;
LOOP(IA,1,4,1) LIM[IA]←INTIN(4)
END;
BEGIN
INTIN(4);
NEP←2*(NOEPA←INTIN(4)-1);
RDEP←REALIX(4)/4.0
END;
BEGIN NEP←2*(NOEPA←WORDIN(4)); GO EDPV1 END;
BEGIN IA←WORDIN(4); GO EDPV1 END
END;
IF NOEPL<NOEPA THEN BEGIN WHERE←11; RETURN; END;
EDP: IF IMAN THEN GO EDPV;
IC←0;
LOOP(IA,1,NEP,1)
BEGIN "EDIN"
IB←INTIN(4);
IF IA MOD 2 THEN
BEGIN
IC←IC+1;
EAX[IC]←(IB%10000000)/10;
EAY[IC]←(IB%1000 MOD 10000)/10
END ELSE BEGIN
EBX[IC]←(IB%10000000)/10;
EBY[IC]←(IB%1000 MOD 10000)/10
END
END "EDIN";
GO EDOUT;
EDPV: IF IMAN≥2 THEN GO EDPV2;
IC←0;
BA1: IE←REALIX(4);
IG←REALIX(4);
REALIN(4);
REALIN(4);
LOOP(IA,1,IE,1)
BEGIN
X←REALIX(4);
Y←REALIX(4);
DX←REALIX(4);
DY←REALIX(4);
EAX[IC←IC+1]←X-DY*RDEP;
EAY[IC]←256.-(Y+DX*RDEP);
EBX[IC]←X+DY*RDEP;
EBY[IC]←256.-(Y-DX*RDEP);
END;
IF IG THEN GO BA1;
KICH←INTIN(4);
LOOP(IA,1,KICH,1) LOOP(IC,1,3,1) TFORM[IA,IC]←REALIX(4);
RDEP←RDEP*2.;
GO EDOUT;
EDPV1: KICH←WORDIN(4);
ARRYIN(4,TFORM[1,1],45);
ARRYIN(4,RDEP,1);
IF IMAN=2∧NOEPL<NOEPA THEN BEGIN WHERE←11; RETURN; END;
EDPV2: ARRYIN(4,LE[1],NOEPA);
ARRYIN(4,EAX[1],NOEPA);
ARRYIN(4,EAY[1],NOEPA);
ARRYIN(4,EBX[1],NOEPA);
ARRYIN(4,EBY[1],NOEPA);
EDOUT: IF IMAN≤1 THEN SORTED;
IF IMAN≤2 THEN DICH[2]←DICH[3]←1;
IF IMAN=3 THEN RENAME(4,NULL,0,IA);
RELEASE(4);
UNTELL
END "EDREST";
_ LISAVE;
_ Saves data-structure on line-level;
INTERNAL SIMPLE PROCEDURE LISAVE;
BEGIN "LISAVE"
INTEGER IA,IB,IC,ID;
DEFINE AML(X)="ARRYOUT(IA,X[1],NOL)";
DEFINE AMV(X)="ARRYOUT(IA,X[1],ID)";
DEFINE AMC(X)="ARRYOUT(IA,X[1],NOV)";
DEFINE WD(X)="WORDOUT(IA,X)";
IF ¬NOL THEN RETURN;
TELL("line-save");
SHUFFL;
ID←2*NOL;
IF IC←EQU(LIEXT,".TEM") THEN BEGIN LIFILE←"LISAVE";LIPPN←NULL END;
OPEN(IA←GETCHAN,"DSK",'14,0,2,IDUM,IB,EO);
ENTER(IA,LIFILE&LIEXT&LIPPN,IB);
IF ¬IC THEN BEGIN WD(NOL);WD(NOV); END;
AML(LEDG1);
AML(LEDG2);
AML(LCREDE);
AMC(LVERSI);
AMV(LVERCO);
AMV(LVER);
AMV(LINK);
AMC(XVCOR);
AMC(YVCOR);
AMV(SVANG);
AMV(XLCOR);
AMV(YLCOR);
AML(CXL);
AML(CYL);
AML(CCL);
AML(RLEN);
AML(ANGARG);
RELEASE(IA);
UNTELL
END "LISAVE";
_ GET EDGE DATA;
SIMPLE MESSAGE PROCEDURE G_EDGES(SAFE REAL ARRAY POINTS;INTEGER CAMERA,
COUNT; REAL SIDLEN);
BEGIN "G_EDGES"
G_PNTS ← GLOBAL NEW(POINTS);
TVCAM ← CAMERA;
RDEP ← SIDLEN/4.0;
NOEPA ← COUNT-1;
NEP ← NOEPA*2;
END "G_EDGES";
INTERNAL SIMPLE PROCEDURE EDREC;
BEGIN "EDREC"
DEFINE GD(I,J)="GLOBAL DATUM(G_PNTS)[I,J]";
REAL X, Y, DX, DY;
INTEGER I;
TELL("receive edges");
IC ← 0;
I ← 0;
DO BEGIN "INP"
I ← I+1;
IE ← GD(I,1);
IG ← GD(I,2);
LOOP(IA,1,IE,1)
BEGIN "INPA"
I ← I+1;
X ← GD(I,1);
Y ← GD(I,2);
DX ← GD(I,3);
DY ← GD(I,4);
IC ← IC+1;
EAX[IC] ← X-DY*RDEP;
EAY[IC] ← 256.-(Y+DX*RDEP);
EBX[IC] ← X+DY*RDEP;
EBY[IC] ← 256.-(Y-DX*RDEP);
END "INPA"
END "INP" UNTIL ¬IG;
IF 1≤TVCAM≤2∧CVN(CURCAM[TVCAM])>0∧CURCAM[TVCAM]≠NIL THEN
ARRTRAN(TFORM,GLOBAL DATUM(CURCAM[TVCAM]));
RDEP ← RDEP*2;
SORTED;
DICH[2] ← DICH[3] ← 1;
UNTELL;
GLOBAL DELETE(G_PNTS);
END "EDREC";
_ LIREST;
_ Restores datastructure as saved by LISAVE;
INTERNAL SIMPLE PROCEDURE LIREST;
BEGIN "LIREST" LABEL ON1;
INTEGER IB,IC,ID;
DEFINE AML(X)="ARRYIN(DCHAN,X[1],NOL)";
DEFINE AMV(X)="ARRYIN(DCHAN,X[1],ID)";
DEFINE AMC(X)="ARRYIN(DCHAN,X[1],NOV)";
DEFINE WD(X)="X←WORDIN(DCHAN)";
IF (IC←EQU(LIEXT,".TEM"))∧¬NOL THEN RETURN;
ID←2*NOL;
IF WHERE=8 THEN GO ON1;
TELL("line-restore");
OPEN(DCHAN←GETCHAN,"DSK",'14,2,0,IDUM,IB,EO);
LOOKUP(DCHAN,JUNKSTR←LIFILE&LIEXT&LIPPN,IB);
IF IB THEN
BEGIN
OUTSTR("FILE "&JUNKSTR&" NOT FOUND"&CL);
RELEASE(DCHAN);
QER;
QRETURN
END;
IF IC THEN GO ON1;
WD(NOL);
WD(NOV);
IB ← NOBAL;
NOBAL←NOL;
IF NOL>IC THEN BEGIN WHERE←8;RETURN; END;
ON1: AML(LEDG1);
AML(LEDG2);
AML(LCREDE);
AMC(LVERSI);
AMV(LVERCO);
AMV(LVER);
AMV(LINK);
AMC(XVCOR);
AMC(YVCOR);
AMV(SVANG);
AMV(XLCOR);
AMV(YLCOR);
AML(CXL);
AML(CYL);
AML(CCL);
AML(RLEN);
AML(ANGARG);
IF IC THEN RENAME(DCHAN,NULL,0,ID);
RELEASE(DCHAN);
UNTELL
END "LIREST";
_ PRSAVE;
_ Stores current prototype data-structure on DSK;
INTERNAL SIMPLE PROCEDURE PRSAVE;
BEGIN "PRSAVE"
INTEGER IA,IB,IC,ID,IE,IG;
IF ¬NPRO THEN RETURN;
TELL("prot-save");
IF IC←EQU(PREXT,".TEM") THEN BEGIN PRFILE←"PRSAVE";PRPPN←NULL END;
OPEN(IA←GETCHAN,"DSK",0,0,2,IDUM,BRAK1,EO);
ENTER(IA,PRFILE&PREXT&PRPPN,IB);
IF ¬IC THEN OUT(IA,"Number of prototypes: "&CVS(NPRO)&CL&CL&
"Max number lines/prot: "&CVS(MAXPLS)&
" vertices/prot: "&CVS(MAXPVS)&CL&CL&
"Total number of lines: "&CVS(PLTOT)&CL&CL&
"Total number of line-features: "&CVS(PLFTOT)&CL&CL&
"Total number of compound features: "&CVS(PCFTOT)&CL&CL&
"Feat.-to-prot. free storage ptr: "&CVS(PFFREE)&CL&CL&
"Prot-c.f.-pairs free storage ptr: "&CVS(PFREE)&
CL&CL&CL&CL);
OUT(IA,"LIST OF PROTOTYPES"&CL&CL&CL&"* * * * * * *"&CL&CL);
LOOP(ID,1,NPRO,1)
BEGIN
OUT(IA,"Prototype number: "&CVS(ID)&CL&CL&
"["&PNAME[ID]&"]"&CL&CL&
CVS(PLINES[ID])&" lines "&CVS(PVERTS[ID])&
" vertices. "&"Storage ptr: "&
CVS(PPTRL[ID])&CL&CL&CL);
OUT(IA,PL("Line",BL,10)&PL("Line-feature (octal)",BL,25)&
PL("Feature id",BL,15)&
PL("Cross-reference (octal)",BL,28));
LOOP(IE,1,PLINES[ID],1)
BEGIN
OUT(IA,CL&CL&PL(CVS(IE),BL,9));
SETFORMAT(-12,2);
OUT(IA,PL(CVOS(PLINEF[IG←IE+PPTRL[ID]-1]),BL,22)&
PL(CVOS(PLINE2[IG]),BL,20)&
PL(CVOS(PLINE[IG]),BL,23));
SETFORMAT(0,2)
END;
OUT(IA,CL&CL&"* * * * * * *"&CL&CL)
END;
OUT(IA,CL&"CENTRAL FEATURE DATA-STRUCTURE"&CL&CL&CL&
"* * * * * * *"&CL&CL&
PL("Feature id number",BL,22)&PL("Feature word (octal)",BL,25)
&PL("Complexity & scene+prot. pointers (octal)",BL,45));
LOOP(ID,1,PFTOT,1)
BEGIN
OUT(IA,CL&CL&PL(CVS(ID),BL,15));
SETFORMAT(-12,2);
OUT(IA,PL(CVOS(PFLST[ID]),BL,27));
OUT(IA,PL(CVOS(PFPTR[ID]),BL,35));
SETFORMAT(0,2)
END;
OUT(IA,CL&CL&"* * * * * * *"&CL&CL&CL&
"PROTOTYPE POINTERS & COMPOUND FEATURE REFERENCES"&CL&CL&CL
&"* * * * * * *"&CL&CL&PL("Address",BL,12)&
PL("Pointers (prot-feat-next)(octal)",BL,37)&
PL("Pointers (prot-feat) & # pairs | Pair & pointer (octal)"
,BL,59));
IG←PFREE MAX PFFREE;
LOOP(ID,1,IG-1,1)
BEGIN
OUT(IA,CL&CL&PL(CVS(ID),BL,13));
SETFORMAT(-12,2);
OUT(IA,PL(IF ID≥PFFREE THEN "0" ELSE CVOS(PFPRO[ID]),BL,29)&
PL(IF ID≥PFREE THEN "0" ELSE CVOS(PFEAT[ID]),BL,47));
SETFORMAT(0,2)
END;
OUT(IA,CL&CL&CL&"* * * * * * *"&CL);
RELEASE(IA);
UNTELL
END "PRSAVE";
_ PRREST;
_ Restores prototype structure from DSK;
INTERNAL SIMPLE PROCEDURE PRREST;
BEGIN "PRREST"
LABEL ON1;
INTEGER IA,IB,IC,ID,IE,IG,ICC;
SIMPLE INTEGER PROCEDURE CVOA(STRING S);
RETURN(IF LENGTH(S)=12∧S[1 FOR 1] LAND 4 THEN
CVO(S) LOR '400000000000 ELSE CVO(S));
IF (IC←EQU(PREXT,".TEM"))∧¬NPRO THEN RETURN;
IF WHERE=17 THEN GO ON1;
TELL("prot-restore");
OPEN(IA←GETCHAN,"DSK",0,2,0,120,BRAK1,EO);
LOOKUP(IA,JUNKSTR←PRFILE&PREXT&PRPPN,IB);
IF IB THEN BEGIN OUTSTR("FILE "&JUNKSTR&" NOT FOUND"&CL);
RELEASE(IA); QER; QRETURN END;
IF ¬IC THEN
BEGIN
NPRO←INTIN(IA);
MAXPLS←INTIN(IA);
MAXPVS←INTIN(IA);
PLTOT←INTIN(IA);
PFTOT←(PLFTOT←INTIN(IA))+(PCFTOT←INTIN(IA));
PFFREE←INTIN(IA);
PFREE←INTIN(IA);
IF NPRO>MXNPRO∨PLTOT>MAXPLT THEN
BEGIN
MXNPRO←(NPRO MAX PLTOT%8)+3;
WHERE←17;
RETURN
END
END;
ON1: BRAK1←0;
LOOP(ID,1,NPRO,1)
BEGIN
WHILE BRAK1≠"[" DO JUNKSTR←INPUT(IA,2);
PNAME[ID]←INPUT(IA,2);
PLINES[ID]←INTIN(IA);
PVERTS[ID]←INTIN(IA);
PPTRL[ID]←INTIN(IA);
LOOP(IE,1,PLINES[ID],1)
BEGIN
ICC←INTIN(IA);
INPUT(IA,11);
PLINEF[IG←IE+PPTRL[ID]-1]←CVOA(INPUT(IA,13));
INPUT(IA,11);
PLINE2[IG]←CVOA(INPUT(IA,13));
INPUT(IA,11);
PLINE[IG]←CVOA(INPUT(IA,13))
END
END;
LOOP(ID,1,PFTOT,1)
BEGIN
ICC←INTIN(IA);
INPUT(IA,11);
PFLST[ID]←CVOA(INPUT(IA,13));
INPUT(IA,11);
PFPTR[ID]←CVOA(INPUT(IA,13))
END;
IB←PFREE MAX PFFREE;
LOOP(ID,1,IB-1,1)
BEGIN
ICC←INTIN(IA);
INPUT(IA,11);
PFPRO[ID]←CVOA(INPUT(IA,13));
INPUT(IA,11);
PFEAT[ID]←CVOA(INPUT(IA,13))
END;
IF IC THEN RENAME(IA,NULL,0,IB);
RELEASE(IA);
UNTELL
END "PRREST";
_ GETLINES
create arrays of active svs and cvs for processing by other jobs;
PROCEDURE GETLINES(SAFEX REAL ARRAY CV,SV; REFERENCE INTEGER C,S);
BEGIN
INTEGER J,K,L;
SAFEX INTEGER ARRAY CNT,CI[1:MAXNOV];
C ← S ← 0;
CNT[1]←0;
ARRBLT(CNT[2],CNT[1],MAXNOV-1);
LOOP (IA,1,MAXNOV,1) IF LVERSI[IA]>0 THEN
BEGIN "GA"
C ← C+1;
CV[C,1] ← XVCOR[IA];
CV[C,2] ← YVCOR[IA];
CI[IA] ← C;
END "GA" ELSE CI[IA] ← 0;
LOOP (IA,1,MAXNOL,1) IF LACT(IA) THEN
BEGIN "GB"
S ← S+1;
K ← IA*2;
J ← K-1;
SV[S,1] ← XLCOR[J];
SV[S,2] ← YLCOR[J];
SV[S,3] ← XLCOR[K];
SV[S,4] ← YLCOR[K];
SV[S,5] ← L ← CI[LVERCO[J]];
CNT[L] ← CNT[L]+1;
SV[S,6] ← L ← CI[LVERCO[K]];
CNT[L] ← CNT[L]+1;
SV[S,7] ← LCREDE[IA] LAND '7777
END "GB";
LOOP(IA,1,MAXNOV,1) IF ¬CNT[IA] THEN CV[IA,1]←CV[IA,2]←0;
END "GETLINES";
_ OUTLINES;
_ output active lines to disk file;
INTERNAL PROCEDURE OUTLINES;
BEGIN
INTEGER BR, C, S, I;
SAFEX REAL ARRAY CV[1:MAXNOV,1:2], SV[1:NOL*2,1:7];
TELL("output struct");
OPEN(4,"DSK",0,1,2,1000,BR,EO←1);
IF EO THEN RETURN;
ENTER(4,NAME&NOUT&".OUT",IDUM);
NOUT ← NOUT+1;
GETLINES(CV,SV,C,S);
OUT(4,CVS(S)&CL);
LOOP(IA,1,S,1)
BEGIN "OA"
SETFORMAT(15,6);
LOOP(I,1,4,1) OUT(4,CVF(SV[IA,I]));
SETFORMAT(15,0);
LOOP(I,5,7,1) OUT(4,CVF(SV[IA,I]));
OUT(4,CL);
END "OA";
OUT(4,CVS(C)&CL);
SETFORMAT(15,6);
LOOP(IA,1,C,1) OUT(4,CVS(IA)&CVF(CV[IA,1])&CVF(CV[IA,2])&CL);
OUT(4,CVS(KICH)&CL);
LOOP(I,1,KICH,1)
BEGIN
LOOP(S,1,3,1) OUT(4,CVF(TFORM[I,S]));
OUT(4,CL);
END;
RELEASE(4);
UNTELL;
END "OUTLINES";
END "SAVRES";